perm filename NETWRK.MID[NET,MRC]4 blob sn#327914 filedate 1978-01-09 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00029 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	Network routines, intended to be .INSRT'ed
C00007 00003	 System bits and bytes
C00010 00004	 Data area
C00012 00005	 More data area, shared by USER and SERVER
C00014 00006	 CONECT -- Connect to foreign host
C00017 00007	 Got socket number from logger
C00020 00008	 LISTEN -- Listen for an ICP from a foreign host
C00024 00009	 Sent socket number to user
C00027 00010	 DATI -- Open data input network channel
C00029 00011	 DATO -- Open data output network channel
C00031 00012	 NETICH/NETICW -- Read a character from the network
C00034 00013	 NETOCH -- Output a character to the network
C00035 00014	 NETSND -- Force network buffer out
C00037 00015	 DATICH/DATICW -- Read a character from the network data channel
C00041 00016	 DATOCH -- Output a character to the network data channel
C00042 00017	 DATSND -- Force network buffer out
C00044 00018	 CLOSER/CLSDAT -- Close a connection
C00045 00019	 NETINR/NETINS -- Send network interrupts to TELNET connection
C00046 00020	 MTPERR -- Explain MTAPE lossage
C00048 00021	 NIOERR -- Explain network I/O lossage
C00050 00022	 Host table routines
C00053 00023	 Host table definitions
C00055 00024	 MAPHST -- Map host table into core
C00057 00025	 UNMHST -- Unmap host table from core
C00059 00026	 HSTNUM -- Return descriptor block for a host
C00061 00027	 HSTNAM -- Return descriptor block for a host name
C00063 00028	 Now comes our super-sexy host name search!
C00066 00029	 All good things must come to an end
C00067 ENDMK
C⊗;
SUBTTL Network routines, intended to be .INSRT'ed

; Mark Crispin, SU-AI, January 1978

;  This is a library of ARPAnet hacking routines.  Each routine describes its
; calling sequence and what AC's it smashes.  Only 0, 1, 2, and 3 are ever used,
; except for HSTNAM which uses 0 → 11.  A pushdown stack is expected in 17.
;  I/O channel 0 is smashed, I/O channel 1 (NET) is used as the general TELNET
; connection channel, and I/O channel 2 (DAT) is used for data I/O.
;  Bugs → MRC.

;  This is the MIDAS version which lives in NETWRK.MID[NET,MRC].  The FAIL version
; lives in NETWRK.FAI[SUB,SYS].

; Assembly switches

IFNDEF SVRRTS,SVRRTS==0			; ≠ 0 → server (not user) routines
IFNDEF DATRTS,DATRTS==0			; ≠ 0 → data channel routines
IFNDEF ERRHAN,ERRHAN==0			; ≠ 0 → automagic error reporting in NIORTS
IFNDEF ERRINS,ERRINS==EXIT		; (iff ERRHAN≠0) what to do after an error

IFNDEF NIORTS,NIORTS==SVRRTS\DATRTS\ERRHAN ; ≠ 0 → network I/O routines

IFNDEF ERRTNS,ERRTNS==ERRHAN		; ≠ 0 → error reporting routines

IFNDEF HSTTAB,HSTTAB==0			; ≠ 0 → host table routines

IFE NIORTS\ERRTNS\HSTTAB,.FATAL No NETWRK routines selected
IFE NIORTS,IFN SVRRTS\DATRTS\ERRHAN,.FATAL NIORTS Illegal switch setting
IFE ERRTNS,IFN ERRHAN,.FATAL ERRHAN Illegal switch setting

; Macro definitions

; FATAL errors type an exclamation point and halt.  WARNings type a question
; mark and continue.

DEFINE FATAL STRING
 PUSHJ 17,[OUTSTR [ASCIZ\!STRING!?\] ? JRST LUZBIG]
TERMIN

DEFINE WARN STRING
 PUSHJ 17,[OUTSTR [ASCIZ\!STRING!!\] ? JRST WARNIN]
TERMIN
; System bits and bytes

.BEGIN NETWRK

; Interrupt condition bits

.U"INTINR==000100,,			; IMP INR
.U"INTINS==000040,,			; IMP INS
.U"INTIMS==000020,,			; IMP status change
.U"INTINP==000010,,			; IMP input waiting

; Network socket status flags

.U"RFCS==  200000,,			; RFC sent
.U"RFCR==  100000,,			; RFC received
.U"CLSS==  040000,,			; CLS sent
.U"CLSR==  020000,,			; CLS received

; Network I/O status bits

.U"HDEAD== 002000			; host or destination IMP dead
.U"CTROV== 001000			; host sent more bits than allocated
.U"RSET==  000400			; host sent a RST
.U"TMO==   000200			; time out

; Network status word error codes

.U"SIU==01				; socket in use
.U"CCS==02				; can't change socket numbers
.U"SYS==03				; horrible system error
.U"NLA==04				; no links available
.U"ILB==05				; illegal byte size
.U"IDD==06				; IMP dead
.U"GMM==07				; Gender mismatch

; I/O status word error bits

.U"IOIMPM==400000			; improper mode
.U"IODERR==200000			; hard device error
.U"IODTER==100000			; soft device error
.U"IOBKTL==040000			; block number out of bounds
.U"IODEND==020000			; end of file

ERRBTS==IOIMPM\IODERR\IODTER\IOBKTL\IODEND\HDEAD\CTROV\RSET\TMO ; all I/O lossage
WINBTS==RFCS\RFCR			; connection winning

; I/O channel definitions

ICP==0					; channel to get socket from logger
.U"NET==1				; channel to do real network hacking
.U"DAT==2				; channel to do data hacking
; Data area

NWKDBG:	0				; -1 → do OUTCHR on network I/O

IFN HSTTAB,[

; Host table pointers

.U"HSTADR:				; ≠ 0 → address of beginning of host table
	BLOCK 1				; = 0 → host table not in core
HSTTOP:	BLOCK 1				; top of host table (JOBFF at map time)

]; End IFN HSTTAB

IFN NIORTS,[

; CONNECT MTAPE block

CONBLK:	0				; CONNECT
CONSTS:	BLOCK 1				; returned status bits
CONLSK:	BLOCK 1				; local socket
CONWAT:	BLOCK 1				; ≠ 0 → wait for connection until timeout
CONBYT:	BLOCK 1				; byte size
.U"ICPSKT:
CONFSK:	BLOCK 1				; foreign socket
.U"HOST:
CONHST:	BLOCK 1				; foreign host

IFN SVRRTS,[

; LISTEN MTAPE block

LSNBLK:	1				; LISTEN
LSNSTS:	BLOCK 1				; returned status bits
.U"LSNSKT:
	BLOCK 1				; local socket to listen to
LSNWAT:	BLOCK 1				; ≠ 0 → wait for connection
LSNBYT:	BLOCK 1				; byte size
LSNFSK:	BLOCK 1				; foreign socket
LSNHST:	BLOCK 1				; foreign host

]; End IFN SVRRTS
; More data area, shared by USER and SERVER

; STATUS MTAPE block

STABLK:	2				; STATUS
STALSS:	BLOCK 1				; status of local send side
STALRS:	BLOCK 1				; status of local receive side

; WAIT MTAPE block

WATBLK:	4				; WAIT
WATSTS:	BLOCK 1				; returned status bits
WATSKT:	BLOCK 1				; socket number

; INTERRUPT MTAPE blocks

INRBLK:	11				; SEND INTERRUPT
INRSTS:	BLOCK 1				; returned status bits
INRSKT:	BLOCK 1				; socket number

INSBLK:	11
INSSTS:	BLOCK 1
INSSKT:	BLOCK 1

; I/O buffer headers

NTIBF:	BLOCK 3				; network input buffer header
NTOBF:	BLOCK 3				; network output buffer header

IFN DATRTS,[
DTIBF:	BLOCK 3				; network data input buffer header
DTOBF:	BLOCK 3				; network data output buffer header
]; End IFN DATRTS

; Base sockets, set up by CONECT and LISTEN

.U"FSOCKT:
	BLOCK 1				; foreign base socket
.U"LSOCKT:
	BLOCK 1				; local base socket

]; End IFN NIORTS
; CONECT -- Connect to foreign host
; Call:	MOVEM <host number>,HOST
;	MOVEM <ICP socket number>,ICPSKT
;	PUSHJ 17,CONECT
;	<error return--MTAPE lossage, status in 0> iff ERRHAN = 0
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0 and 1.

IFN NIORTS,[

IFE SVRRTS,[

; Open channels and set timeouts

.U"CONECT:
IFN ERRHAN,[
	PUSHJ 17,.CONEC
	 JRST [PUSHJ 17,MTPERR ? ERRINS]
	 JRST [PUSHJ 17,NIOERR ? ERRINS]
	POPJ 17,
]; End IFN ERRHAN
.CONEC:	INIT ICP,17			; open ICP in dump mode
	 'IMP,,				; device IMP:
	 0				; no buffers
	 FATAL Unable to INIT the IMP
	MTAPE ICP,[17 ? .BYTE 6 ?0?24?0?7?7?0]; set timeouts
	INIT NET,0			; open NET in ASCII mode
	 'IMP,,
	 NTOBF,,NTIBF			; buffers
	 FATAL Unable to INIT the IMP
	MTAPE NET,[17 ? .BYTE 6 ?2?24?0?7?0?0]

; Gensym a unique socket number.
; Algorithm used is: job #,,<time&777770>

	PJOB				; get my job #
	MSTIME 1,			; and the time now
	LSH 18.				; put job # in LH
	HRRI (1)			; and time in RH
	TRZ 7				; but zap low order bits

; Now try to get to the foreign host's logger

	MOVEM CONLSK			; my socket to use
	MOVEM LSOCKT			; save local base socket
	SETOM CONWAT			; do wait until timeout
	MTAPE ICP,CONBLK		; connect → foreign logger
	MOVE CONSTS			; check for MTAPE error
	TRNE 77
	 POPJ 17,
	MOVE 1,
	GETSTS ICP,			; check for I/O error
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE 1
	TLC (WINBTS)			; for next instruction to win
	TLCE (WINBTS)			; legal socket state?
	 POPJ 17,
	HRROI CONFSK-1			; get ready to get a socket
	SETZ 1,				; stop code for dump mode

; Get socket number from logger

	IN ICP,				; get socket from logger
	 JRST GOTSKT			; won
	GETSTS ICP,			; I/O error??!
	JRST CPOPJ1
; Got socket number from logger

GOTSKT:	LDB [044000,,CONFSK]		; get socket we got
	MOVEM CONFSK			; and save it back
	MOVEM FSOCKT			; save foreign base socket for later
	CLOSE ICP,
	RELEAS ICP,			; free up channel

; Now connect output

	MOVEI 3				; ICP/transmit offset
	ADDB CONLSK			; local transmit socket
	MOVEM WATSKT			; save wait socket
	MOVEM INSSKT
	SETZM CONWAT			; don't wait
	MOVEI 8.			; 8 bit bytes
	MOVEM CONBYT
	MTAPE NET,CONBLK		; connect ← server output
	MOVE CONSTS			; test for error
	TRNE 77
	 POPJ 17,

; Now connect input

	SOS CONLSK			; local receive socket
	AOS CONFSK			; foreign transmit socket
	MTAPE NET,CONBLK		; connect → server input
	MOVE CONSTS			; test for error
	TRNE 77
	 POPJ 17,

; Connections started, now wait for output

	MTAPE NET,WATBLK		; wait for output
	MOVE WATSTS			; get status
	TRNE 77
	 POPJ 17,
	MOVE 1,
	GETSTS NET,
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE 1
	TLC (WINBTS)
	TLCE (WINBTS)
	 POPJ 17,

; Output connected, now wait for input

	SOS 1,WATSKT			; now select receive socket
	MOVEM 1,INRSKT
	MTAPE NET,WATBLK		; wait for input
	MOVE WATSTS			; get status
	TRNE 77
	 POPJ 17,
	MOVE 1,
	GETSTS NET,
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE 1
	TLC (WINBTS)
	TLCE (WINBTS)
	 POPJ 17,

; Set up allocations, buffer headers, and return.

	MTAPE NET,[15 ? 1]		; system maximum allocation
	MOVEI 8.			; change byte size in buffer header
	DPB [300600,,NTIBF+1]
	DPB [300600,,NTOBF+1]
	INBUF NET,
	OUTBUF NET,
	MTAPE NET,[10]
	 JFCL
	JRST CPOPJ2

]; End IFE SVRRTS
; LISTEN -- Listen for an ICP from a foreign host
; Call:	MOVEM <ICP socket number>,LSNSKT
;	PUSHJ 17,LISTEN
;	<error return--MTAPE lossage, status in 0> iff ERRHAN = 0
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return--host we connected to in HOST>
; Smashes 0 and 1.

IFN SVRRTS,[

; Open channels and set timeouts (punts after a minute)

.U"LISTEN:
IFN ERRHAN,[
	PUSHJ 17,.LISTE
	 JRST [PUSHJ 17,MTPERR ? ERRINS]
	 JRST [PUSHJ 17,NIOERR ? ERRINS]
	POPJ 17,
]; End IFN ERRHAN
.LISTE:	INIT ICP,17			; open ICP in dump mode
	 'IMP,,				; device IMP:
	 0				; no buffers
	 FATAL Unable to INIT the IMP
	MTAPE ICP,[17 ? .BYTE 6 ?0?24?0?60.?0?0]; set timeouts
	INIT NET,0			; open NET in ASCII mode
	 'IMP,,
	 NTOBF,,NTIBF			; buffers
	 FATAL Unable to INIT the IMP
	MTAPE NET,[17 ? .BYTE 6 ?2?24?0?7?0?0]

; Now wait for the foreign host to send us an RFC

	MOVE LSNFSK
	MOVEI 32.			; ICP byte size
	MOVEM LSNBYT
	SETOM LSNWAT			; do wait until timeout
	MTAPE ICP,LSNBLK
	MOVE LSNSTS			; check for MTAPE error
	TRNE 77
	 POPJ 17,
	MOVE 1,
	GETSTS ICP,			; check for I/O error
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE 1
	TLC (WINBTS)			; for next instruction to win
	TLCE (WINBTS)			; legal socket state?
	 POPJ 17,
	MOVE LSNHST
	MOVEM CONHST
	MOVE LSNFSK
	MOVEM FSOCKT			; save foreign base socket
	ADDI 3
	MOVEM CONFSK

; Gensym a unique socket number.
; Algorithm used is: job #,,<time&777770>

	PJOB				; get my job #
	MSTIME 1,			; and the time now
	LSH 18.				; put job # in LH
	HRRI (1)			; and time in RH
	TRZ 7				; but zap low order bits
	MOVEM LSOCKT			; save local base socket
	MOVEM CONLSK
	MOVEM WATSKT			; save wait socket
	MOVEM INRSKT
	DPB [044000,,LSNSKT]

; Send socket number to user

	HRROI LSNSKT-1			; get ready to send a socket
	SETZ 1,				; stop code for dump mode
	OUT ICP,
	 JRST SNTSKT			; won
	GETSTS ICP,			; I/O error??!
	JRST CPOPJ1
; Sent socket number to user

SNTSKT:	CLOSE ICP,
	RELEAS ICP,			; free up channel

; Now connect input

	SETZM CONWAT			; don't wait
	MTAPE NET,CONBLK		; connect ← user output
	MOVE CONSTS			; test for error
	TRNE 77
	 POPJ 17,

; Now connect output

	MOVEI 8.			; 8 bit bytes
	MOVEM CONBYT
	AOS CONLSK			; local receive socket
	SOS CONFSK			; foreign transmit socket
	MTAPE NET,CONBLK		; connect → user input
	MOVE CONSTS			; test for error
	TRNE 77
	 POPJ 17,

; Connections started, now wait for input

	MTAPE NET,WATBLK		; wait for input
	MOVE WATSTS			; get status
	TRNE 77
	 POPJ 17,
	MOVE 1,
	GETSTS NET,
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE 1
	TLC (WINBTS)
	TLCE (WINBTS)
	 POPJ 17,

; Input connected, now wait for output

	AOS 1,WATSKT			; now select send socket
	MOVEM 1,INSSKT
	MTAPE NET,WATBLK		; wait for input
	MOVE WATSTS			; get status
	TRNE 77
	 POPJ 17,
	MOVE 1,
	GETSTS NET,
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE 1
	TLC (WINBTS)
	TLCE (WINBTS)
	 POPJ 17,

; Set up allocations, buffer headers, and return.

	MTAPE NET,[15 ? 1]		; system maximum allocation
	MOVEI 8.			; change byte size in buffer header
	DPB [300600,,NTIBF+1]
	DPB [300600,,NTOBF+1]
	INBUF NET,
	OUTBUF NET,
	MTAPE NET,[10]
	 JFCL
	JRST CPOPJ2

]; End IFN SVRRTS
; DATI -- Open data input network channel
; Call:	PUSHJ 17,DATI
;	<error return--MTAPE lossage, status in 0> iff ERRHAN = 0
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return--byte size in 0>
; Smashes 0 and 1.

IFN DATRTS,[

.U"DATI:
IFN ERRHAN,[
	PUSHJ 17,.DATI
	 JRST [PUSHJ 17,MTPERR ? ERRINS]
	 JRST [PUSHJ 17,NIOERR ? ERRINS]
	POPJ 17,
]; End IFN ERRHAN
.DATI:	CHNSTS DAT,			; check for channel open
	JUMPN .DATI1
	INIT DAT,0			; open channel
	 'IMP,,
	 DTOBF,,DTIBF			; buffers
	 FATAL Unable to INIT the IMP
	MTAPE DAT,[17 ? .BYTE 6 ?2?24?0?7?0?0]
.DATI1:	MOVE LSOCKT
	ADDI 4				; ICP/U receive data offset
	MOVEM CONLSK			; local receive socket
	MOVE FSOCKT
	ADDI 3				; ICP/S transmit data offset
	MOVEM CONFSK			; foreign transmit socket
	SETOM CONWAT			; wait
	MTAPE DAT,CONBLK		; connect ← foreign data output
	MOVE CONSTS			; test for error
	TRNE 77
	 POPJ 17,
	MOVE 1,
	GETSTS DAT,
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE 1
	TLC (WINBTS)
	TLCE (WINBTS)
	 POPJ 17,
	MTAPE DAT,[15 ? 1]		; system maximum allocation
	MOVE CONBYT			; change byte size in buffer header
	DPB [300600,,DTIBF+1]
	INBUF DAT,
	MTAPE DAT,[10]
	 JFCL
	JRST CPOPJ2
; DATO -- Open data output network channel
; Call:	MOVEI <byte size of connection>
;	PUSHJ 17,DATO
;	<error return--MTAPE lossage, status in 0> iff ERRHAN = 0
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0 and 1.

.U"DATO:
IFN ERRHAN,[
	PUSHJ 17,.DATO
	 JRST [PUSHJ 17,MTPERR ? ERRINS]
	 JRST [PUSHJ 17,NIOERR ? ERRINS]
	POPJ 17,
]; End IFN ERRHAN
.DATO:	MOVEM CONBYT
	CHNSTS DAT,
	JUMPN DAT,.DATO1
	INIT DAT,0			; open channel
	 'IMP,,
	 DTOBF,,DTIBF			; buffers
	 FATAL Unable to INIT the IMP
	MTAPE DAT,[17 ? .BYTE 6 ?2?24?0?7?0?0]
.DATO1:	MOVE LSOCKT
	ADDI 5				; ICP/U transmit data offset
	MOVEM CONLSK			; local receive socket
	MOVE FSOCKT
	ADDI 2				; ICP/S receive data offset
	MOVEM CONFSK			; foreign transmit socket
	SETOM CONWAT			; wait
	MTAPE DAT,CONBLK		; connect → foreign data input
	MOVE CONSTS			; test for error
	TRNE 77
	 POPJ 17,
	MOVE 1,
	GETSTS DAT,
	TRNE ERRBTS
	 JRST CPOPJ1
	MOVE 1
	TLC (WINBTS)
	TLCE (WINBTS)
	 POPJ 17,
	MOVE CONBYT			; change byte size in buffer header
	DPB [300600,,DTOBF+1]
	OUTBUF DAT,
	JRST CPOPJ2

]; End IFN DATRTS
; NETICH/NETICW -- Read a character from the network
; Call:	PUSHJ 17,NETICH or PUSHJ 17,NETICW
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<error return--no characters available> iff NETICH
;	<return--character in 0>
; Smashes 0, 1, and 2.

.U"NETICH:
	TDZA 2,2			; don't hang
.U"NETICW:
	 SETO 2,			; hang
IFN ERRHAN,[
	PUSHJ 17,NTICH2
	 JRST [PUSHJ 17,NIOERR ? ERRINS]
	 POPJ 17,			; NETICW or empty NETICH
	JRST CPOPJ1			; NETICH return
]; End IFN ERRHAN
NTICH2:	SOSLE NTIBF+2			; anything in buffer?
	 JRST NTICH3
	JUMPE 2,[	HRRZ 1,NTIBF
			HRRZ 1,(1)
			SKIPGE (1)	; anything in further buffers?
			 JRST .+1
			MTAPE NET,[10]	; no, any input available?
			 JRST CPOPJ1	; no, empty error return
			JRST .+1]	; input available or hang
	IN NET,				; yes, read the buffer
	 JRST NTICH3			; won
	GETSTS NET,			; error, get status
	POPJ 17,			; I/O error return
NTICH3:	IBP NTIBF+1			; increment pointer to hack
	MOVE @NTIBF+1			; get word to hack
	ANDI 17 			; only marking bits
	JFFO NTICH1			; count leading zeros
	LDB NTIBF+1			; get the character
	SKIPE NWKDBG
	 OUTCHR
	JUMPN 2,CPOPJ1			; NETICW only skips once
	JRST CPOPJ2			; NETICH good return

; Have to flush nulls here.

NTICH1:	MOVNI 1,-44(1)			; get -1,,# of padding characters
	HRRZM 1,1(17)			; stash # of characters away on stack
	MOVEI 1,-1(1)			; # of characters to take off buffer
	SUBM 1,NTIBF+2			; remove padding characters from count
	MOVNS NTIBF+2			; SUBM goes the wrong way
	ADJBP 1,NTIBF+1			; move byte pointer
	MOVEM 1,NTIBF+1			; save pointer
	MOVN 1,1(17)			; get # of characters back from stack
	LSH 1,3				; # of bits to shift over
	MOVE @NTIBF+1			; get word we are hacking
	LSH (1)				; right justify its bytes
	MOVEM @NTIBF+1			; store it back again
	JRST NTICH2			; now try it again
; NETOCH -- Output a character to the network
; Call:	MOVE <character>
;	PUSHJ 17,NETOCH
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0.

.U"NETOCH:
IFN ERRHAN,[
	PUSHJ 17,.NETOC
	 JRST [PUSHJ 17,NIOERR ? ERRINS]
	POPJ 17,
]; End IFN ERRHAN
.NETOC:	SOSG NTOBF+2			; space available in buffer?
	 OUT NET,			; no, output it
	  CAIA				; win
	   JRST NETOER
	IDPB NTOBF+1			; put character in buffer
	SKIPE NWKDBG
	 OUTCHR
	JRST CPOPJ1			; success
; NETSND -- Force network buffer out
; Call:	PUSHJ 17,NETSND
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0 and 1.

.U"NETSND:
IFN ERRHAN,[
	PUSHJ 17,.NETSN
	 JRST [PUSHJ 17,NIOERR ? ERRINS]
	POPJ 17,
]; End IFN ERRHAN
.NETSN:	LDB 1,[410300,,NTOBF+1]		; get position field
	MOVEI 1
	LSH (1)				; AC0 ← 2↑<# of null characters>
	SOS				; AC0 ← mask to flush nulls
	IORM @NTOBF+1			; ensure padding nulls aren't sent
	OUT NET,			; send the buffer
	 JRST [	AOS NTOBF+2		; poor NETOCH will lose big otherwise
		JRST CPOPJ1]
NETOER:	GETSTS NET,			; lost, get status
	POPJ 17,			; and return
; DATICH/DATICW -- Read a character from the network data channel
; Call:	PUSHJ 17,DATICH or PUSHJ 17,DATICW
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<error return--no characters available> iff DATICH
;	<return--character in 0>
; Smashes 0, 1, and 2.

IFN DATRTS,[

.U"DATICH:
	TDZA 2,2			; don't hang
.U"DATICW:
	 SETO 2,			; hang
IFN ERRHAN,[
	PUSHJ 17,DTICH2
	 JRST [PUSHJ 17,NIOERR ? ERRINS]
	 POPJ 17,			; DATICW or empty DATICH
	JRST CPOPJ1			; DATICH return
]; End IFN ERRHAN
DTICH2:	SOSLE DTIBF+2			; anything in buffer?
	 JRST DTICH3
	JUMPE 2,[	HRRZ 1,DTIBF
			HRRZ 1,(1)
			SKIPGE (1)	; anything in further buffers?
			 JRST .+1
			MTAPE DAT,[10]	; no, any input available?
			 JRST CPOPJ1	; no, empty error return
			JRST .+1]	; input available or hang
	IN DAT,				; yes, read the buffer
	 JRST DTICH3			; won
	GETSTS DAT,			; error, get status
	POPJ 17,			; I/O error return
DTICH3:	LDB [300600,,DTIBF+1]		; get byte size
	CAIE 8.
	 JRST [	ILDB DTIBF+1		; non-ASCII data mode
		JUMPN 2,CPOPJ1
		JRST CPOPJ2]
	IBP DTIBF+1			; increment pointer to hack
	MOVE @DTIBF+1			; get word to hack
	ANDI 17 			; only marking bits
	JFFO DTICH1			; count leading zeros
	LDB DTIBF+1			; get the character
	JUMPN 2,CPOPJ1			; DATICW only skips once
	JRST CPOPJ2			; DATICH good return

; Have to flush nulls here.

DTICH1:	MOVNI 1,-44(1)			; get -1,,# of padding characters
	HRRZM 1,1(17)			; stash # of characters away on stack
	MOVEI 1,-1(1)			; # of characters to take off buffer
	SUBM 1,DTIBF+2			; remove padding characters from count
	MOVNS DTIBF+2			; SUBM goes the wrong way
	ADJBP 1,DTIBF+1			; move byte pointer
	MOVEM 1,DTIBF+1			; save pointer
	MOVN 1,1(17)			; get # of characters back from stack
	LSH 1,3				; # of bits to shift over
	MOVE @DTIBF+1			; get word we are hacking
	LSH (1)				; right justify its bytes
	MOVEM @DTIBF+1			; store it back again
	JRST DTICH2			; now try it again
; DATOCH -- Output a character to the network data channel
; Call:	MOVE <character>
;	PUSHJ 17,DATOCH
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0.

.U"DATOCH:
IFN ERRHAN,[
	PUSHJ 17,.DATOC
	 JRST [PUSHJ 17,NIOERR ? ERRINS]
	POPJ 17,
]; End IFN ERRHAN
.DATOC:	SOSG DTOBF+2			; space available in buffer?
	 OUT DAT,			; no, output it
	  CAIA				; win
	   JRST DATOER
	IDPB DTOBF+1			; put character in buffer
	JRST CPOPJ1			; success
; DATSND -- Force network buffer out
; Call:	PUSHJ 17,DATSND
;	<error return--I/O error, status in 0> iff ERRHAN = 0
;	<return>
; Smashes 0 and 1.

.U"DATSND:
IFN ERRHAN,[
	PUSHJ 17,.DATSN
	 JRST [PUSHJ 17,NIOERR ? ERRINS]
	POPJ 17,
]; End IFN ERRHAN
.DATSN:	LDB 1,[410300,,DTOBF+1]		; get position field
	MOVEI 1
	LSH (1)				; AC0 ← 2↑<# of null characters>
	SOS				; AC0 ← mask to flush nulls
	IORM @DTOBF+1			; ensure padding nulls aren't sent
	OUT DAT,			; send the buffer
	 JRST [	AOS DTOBF+2		; poor NETOCH will lose big otherwise
		JRST CPOPJ1]
DATOER:	GETSTS DAT,			; lost, get status
	POPJ 17,			; and return

]; End IFN DATRTS
; CLOSER/CLSDAT -- Close a connection
; Call:	PUSHJ 17,CLOSER or PUSHJ 17,CLSDAT
;	<return>
; Smashes 0.

.U"CLOSER:
	CLOSE NET,
	RELEASE NET,
	OUTSTR [ASCIZ/
Connection closed.
/]
	POPJ 17,

IFN DATRTS,[

.U"CLSDAT:
	CLOSE DAT,
	RELEASE DAT,
	POPJ 17,

]; End IFN DATRTS
; NETINR/NETINS -- Send network interrupts to TELNET connection
; Call:	PUSHJ 17,NETINR (or NETINS)
;	<return>
; Smashes 0.

.U"NETINR:
	MTAPE NET,INRBLK		; interrupt from receiver
	POPJ 17,

.U"NETINS:
	MTAPE NET,INSBLK		; interrupt from sender
	POPJ 17,

]; End IFN NIORTS
; MTPERR -- Explain MTAPE lossage
; Call:	MOVE <MTAPE status bits>
;	PUSHJ 17,MTPERR
;	<return>
; Smashes 0 and 1.

IFN ERRTNS,[

.U"MTPERR:
	TRNE 77				; UUO lossage?
	 JRST MTPER1			; yes, different message
	TLNN (CLSR)			; closed by foreign host?
	 SKIPA 1,[[ASCIZ/Time out
/]]
	  MOVEI 1,[ASCIZ/Refused
/]
	OUTSTR (1)
	CLRBFI
	POPJ 17,

; MTAPE UUO lossage

MTPER1:	ANDI 77				; only error code
	CAILE MERLEN			; error code too high?
	 JRST [	OUTSTR [ASCIZ/Unknown MTAPE error #/]
		IDIVI 10
		ADDI "0
		ADDI 1,"0
		OUTCHR
		OUTCHR 1
		JRST MTPE1A]
	MOVE 1,
	OUTSTR @MERTAB-1(1)		; output the error string
MTPE1A:	WARN
	CLRBFI
	POPJ 17,

MERTAB:	[ASCIZ/Socket already in use/]
	[ASCIZ/Can't change socket numbers/]
	[ASCIZ/Horrible system error/]
	[ASCIZ/No links available/]
	[ASCIZ/Illegal byte size/]
	[ASCIZ/Our NCP is dead/]
	[ASCIZ/Gender mismatch/]
MERLEN==.-MERTAB
; NIOERR -- Explain network I/O lossage
; Call:	MOVE <I/O status bits>
;	PUSHJ 17,NIOERR
;	<return>
; Smashes 0.

.U"NIOERR:
	ANDI ERRBTS			; only error bits
	SKIPN
	 WARN No error status at NIOERR
	TRNE IOIMPM\IOBKTL
	 WARN IOIMPM or IOBKTL set at NIOERR
	TRNE CTROV
	 WARN Host exceeded allocation
	TRNE HDEAD
	 OUTSTR [ASCIZ/Host dead
/]
	TRNE RSET
	 OUTSTR [ASCIZ/Host sent a RESET
/]
	TRNE TMO
	 OUTSTR [ASCIZ/Time out
/]
	TRNE IODEND
	 OUTSTR [ASCIZ/Host closed connection
/]
	TRZE IODERR
	 TRO IODTER
	CAIN IODTER
	 OUTSTR [ASCIZ/Host died
/]					; actually incomplete transmission
	CLRBFI
	POPJ 17,

]; End IFN ERRTNS
; Host table routines

IFN HSTTAB,[

COMMENT ⊗

The format of the host table binary file is:

word 0	SIXBIT /HOSTS1/
word 1	SIXBIT /HOSTS/
word 2	version HOSTS file which this was compiled from.
word 3	user name of person who compiled this generation of the host table
word 4	Date of compilation as sixbit YYMMDD
word 5	Time of compilation as sixbit HHMMSS
word 6	Address in file of NAME table.
word 7	Address in file of NUMBER table.

NUMBERS table:
word 0	Number of entries in this table.
word 1	Number of words per entry (currently 3).
followed by entries, in order by host number.

Each entry looks like this:
word 0	host number
word 1	LH  pointer to system name (ITS, TIP, TENEX, etc.)
	May be 0 → not known.
word 1  RH  pointer to official name of host.
word 2  LH  flags:
	4.9 1 → server site.
word 2  RH  pointer to machine name (PDP10, etc).
	May be 0 → not known.
...

NAMES table:
word 0	Number of entries
followed by one word entries, sorted by the host name treated as a vector of
signed integers, looking like:

word 0	LH  address in file of NUMBERS table entry for this host.
	RH  pointer to host name
...

Host, system and machine names are ASCIZ strings, all letters upper case.
The strings are stored before, after and between the NAME and NUMBER tables.

⊗
; Host table definitions

; Table header

HSTSID==0				; SIXBIT /HOSTS1/
HSTFN1==1				; SIXBIT /HOSTS/
HSTVRS==2				; FN2 of HOSTS file (if compiled at MIT)
HSTWHO==3				; User name of person who compiled
HSTDAT==4				; Date of compilation as sixbit YYMMDD
HSTTIM==5				; Time of compilation as sixbit HHMMSS
NAMPTR==6				; Address in file of NAMES table.
NUMPTR==7				; Address in file of NUMBERS table.

; NUMBERS table

NUMNUM==0				; host number
NUMSYS==1				; LH  pointer to system name
NUMNAM==1				; RH  pointer to official name of host.
NUMBTS==2				; LH  flags:
NUMSRV==400000				; 4.9 → server site.
NUMMCH==2				; RH  pointer to machine name

; NAMES table

NAMNAM==0				; <numbers pointer,,host name pointer>
; MAPHST -- Map host table into core
; Call:	PUSHJ 17,MAPHST
;	<return>
; Smashes 0, 1, 2, and 3.

.U"MAPHST:
	SKIPE HSTADR
	 JRST [	WARN Host table already mapped
		POPJ 17,]
	OPEN [17 ? 'DSK,, ? 0]		; get a disk channel
	 FATAL DSK OPEN failed
	MOVE ['HOSTS1] ? MOVSI 1,'BIN ? SETZ 2, ? MOVE 3,['NETMRC]
	LOOKUP				; find file HOSTS1.BIN[NET,MRC]
	 JRST [	OUTSTR [ASCIZ/Host table LOOKUP failure (/]
		ANDI 1,77
		IDIVI 1,10
		ADDI 1,"0 ? ADDI 2,"0
		OUTCHR 1 ? OUTCHR 2
		FATAL [)]]
	MOVE 2,JOBFF
	MOVS 3 ? MOVN ? ADDB JOBFF	; get address of highest addr we need
	MOVEM HSTTOP
	CORE				; get more core from system maybe
	 FATAL Failed to get enough core to read in host table
	MOVE 3 ? HRRI -1(2)		; compute IOWD to read host table in
	SETZ 1,
	INPUT
	MOVE (2)			; get first word of host table
	CAME ['HOSTS1]
	 WARN Host table in unexpected format
	MOVEM 2,HSTADR			; remember where host table begins
	POPJ 17,
; UNMHST -- Unmap host table from core
; Call:	PUSHJ 17,UNMHST
;	<return>
; Smashes 0 and 1.

.U"UNMHST:
	SKIPN 1,HSTADR			; host table in core?
	 JRST [	WARN Host table not mapped
		POPJ 17,]
	MOVE (1)
	CAME ['HOSTS1]
	 WARN Host table in unexpected format
	MOVE HSTTOP			; check JOBFF from before
	CAMLE JOBFF			; smashed too?
	 FATAL Host table extends after current JOBFF
	CAME JOBFF
	 JRST [	WARN Host table locked in core
		POPJ 17,]
	SETZM HSTADR			; remove table pointer/interlock
	MOVEM 1,JOBFF			; return host table to free storage
	CORE 1,				; and garbage collect
	 WARN CORE UUO failed to return core
	POPJ 17,
; HSTNUM -- Return descriptor block for a host
; Call:	MOVEI <host number>
;	PUSHJ 17,HSTNUM
;	<error return--no such host>
;	<return--absolute NAMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2>
; Smashes 0, 1, 2, and 3.

.U"HSTNUM:
	SKIPN 1,HSTADR			; fail if host table not mapped
	 FATAL Host table not mapped
	MOVE 2,(1)
	CAME 2,['HOSTS1]
	 WARN Host table in unexpected format
	MOVE 1,NUMPTR(1)
	ADD 1,HSTADR			; address of NUMBERS table
	MOVE 2,(1)			; get # of entries
	MOVE 3,1(1)			; and entry size
	ADDI 1,2			; point at first entry
HSTNU1:	CAMN (1)			; found host?
	 JRST [	AOS (17)		; yes, set up skip return
		JRST GETBL0]		; and set up the block
	ADD 1,3				; point at next entry
	SOJG 2,HSTNU1			; keep on searching
	POPJ 17,			; failure
; HSTNAM -- Return descriptor block for a host name
; Call:	MOVEI <pointer to host name string>
;	PUSHJ 17,HSTNAM
;	<error return--no such host>
;	<error return--ambiguous name>
;	<return--absolute NAMNUM in 0, NUMSYS,,NUMNAM in 1, NUMBTS,,NUMMCH in 2>
; Smashes 0 → 11 (!!!).

.U"HSTNAM:
	SKIPN 1,HSTADR			; fail if host table not mapped
	 FATAL Host table not mapped
	MOVE 2,(1)
	CAME 2,['HOSTS1]
	 WARN Host table in unexpected format

;  Set up various AC's for hairy search below.  0 has the byte pointer of the
; input host, 1 has the host table pointer, 2 has the character count, 5 is
; always zero, 10 holds a server pointer, 11 holds a user pointer.  3-7 are
; used for KL-10 magic.

	SETZ 5,				; 5 isn't used by CMPSE
	SETZB 10,11			; init pointers
	MOVE 2,NAMPTR(1)
	ADD 2,HSTADR			; address of NAMES table
	HRLO 1,(2)			; # of entries,,-1
	EQVI 1,(2)			; -<1+# of entries>,,table-1
	ADJSP 1,1			; now have AOJBN pointer to table
	HRLI 440700			; make byte pointer
	MOVE 3,
	SETZ 2,				; character count
CNTCHR:	ILDB 4,3
	JUMPE 4,[	JUMPE 2,CPOPJ	; null specification loses
			JRST SEARCH]
	CAIL 4,"a			; lowercase?
	 SUBI 4,"a-"A
	DPB 4,3
	AOJA 2,CNTCHR
; Now comes our super-sexy host name search!

SEARCH:	MOVE 3,2 ? MOVE 6,2		; set up counters
	MOVE 4,0			; source byte pointer
	HRRZ 7,(1)			; get rel address of host
	ADD 7,HSTADR			; make absolute
	HRLI 7,440700			; and a byte pointer
	EXTEND 3,[002000,,]		; CMPSE → skip if =
	 AOBJN 1,SEARCH			; not equal, fail
	JUMPGE 1,SRCDUN			; search done when table completed
	HLRZ 3,(1) ? ADD 3,HSTADR	; get pointer to NUMBERS block
	ILDB 6,7			; get last character; null means exact match
	JUMPE 6,[	MOVE 10,3	; got match...stop searching forever
			JRST SRCDUN]	; love is here to stay
	MOVE 6,2(3)			; NUMBTS
	TLNE 6,NUMSRV			; server?
	 JRST [	CAMN 10,3		; all self-matches win
		 JRST SRCH1
		SKIPE 10		; somebody there?
		 TLOA 10,-1		; yah, loser
		  MOVE 10,3		; else remember the name
		AOBJN 1,SEARCH		; keep on hunting
		JRST SRCDUN]		; else done
	CAMN 11,3			; self-matcher?
	 JRST SRCH1
	SKIPE 11			; already seen a user?
	 TLOA 11,-1			; remember can't be a user
	  MOVE 11,3			; else remember the pointer
SRCH1:	AOBJN 1,SEARCH			; maybe could be a server in there

; Search done, set up block ala HSTNUM and return

SRCDUN:	SKIPN 1,10			; use server if found one
	 MOVE 1,11			; no server, maybe a user
	JUMPE 1,CPOPJ			; no match at all
	SKIPL 1				; ambiguous name?
	 AOS (17)			; no, set up double skip return
AMBNAM:	AOS (17)			; ordinary skip return

; Routine to get a block of host specifications with pointer in 1.

GETBLK:	MOVE (1)			; host number
GETBL0:	MOVE 2,2(1)			; NUMBTS,,NUMMCH
	TRNE 2,-1
	 ADD 2,HSTADR
	MOVE 1,1(1)			; NUMSYS,,NUMNAM
	TLNN 1,-1
	 JRST [	ADD 1,HSTADR		; case of unknown system name
		POPJ 17,]
	ADJSP 1,@HSTADR
	POPJ 17,			; and return

]; End IFN HSTTAB
; All good things must come to an end

; Return routines

.U"CPOPJ2:
	AOS (17)			; double skip return
.U"CPOPJ1:
	AOS (17)			; skip return
.U"CPOPJ:
	POPJ 17,			; return to caller

; Warning

.U"WARNIN:
	OUTSTR [ASCIZ/
This is not expected to occur.  Please report this via GRIPE.
/]
	POPJ 17,

; Fatality!

.U"LUZBIG:
	OUTSTR [ASCIZ/
Find a wizard.  Type CONTINUE to try to recover.
/]
	JRST 4,WARNIN

..NLIT:	CONSTANTS

.END NETWRK